home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / 68000 / lib / readln.pl < prev    next >
Encoding:
Text File  |  1992-05-26  |  5.8 KB  |  200 lines
  1. /*  $Id: readln.pl,v 1.1.1.1 1992/05/26 11:51:37 jan Exp $
  2.  
  3.     Read a sentence from the current input stream and convert it
  4.     into a list of atoms and numbers.
  5.     Letters(A-Z, a-z) are converted to atoms
  6.     Digits (0-9) (and a '.' if a real number) are converted to numbers
  7.     Some obscure 'rounding' is done, so you have most of the times
  8.     only 6 significant digits with an exponent part. (This is caused
  9.     by the system predicate 'name'. If you want looonnnggg numbers
  10.     then define digits as parts of words).
  11.     (N.B. reals work only if '.' is not defined as 'stop-char' but
  12.         'escape' will work in this case)
  13.  
  14.     The reader is >>flexible<<, you can define yourself:
  15.     - the character on which reading will stop
  16.         (this character is escapable with \
  17.          to read a \ type this character twice!!)
  18.     - the character(s) that make up a word (execpt the
  19.       characters A-Z, a-z that always make up words!!
  20.       and (real)-numbers that always are grouped together!!)
  21.     - whether you want conversion of uppercase letters to
  22.       lowercase letters.
  23.  
  24.     readln/1
  25.     The default setting for readln/1 is
  26.         - read up till newline
  27.         - see underscore('_') and numbers 0-9 as part of words
  28.         - make lowercase
  29.  
  30.         - If nothing is read readln/1 succeeds with []
  31.         - If an end_of_file is read readln/1 succeeds with [..|end_of_file]
  32.  
  33.  
  34.     readln/5
  35.     This predicate gives you the flexibility.
  36.     It succeeds with arg1 = list of word&atoms
  37.              arg2 = Ascii code of last character
  38.                 (but 'end_of_file' in case of ^D).
  39.     To change one or more of the defaults you have to
  40.     instantiate argument3 and/or argument4 and/or argument5.
  41.      !! Uninstantiated arguments are defaulted !!
  42.     - stop character(s):
  43.         instantiate argument 3 with the list of ASCII code's
  44.         of the desired stop characters (Note: you can also
  45.         say: ".!?", what is equivalent to [46,33,63] ).
  46.     - word character(s):
  47.         instantiate argument 4 with the list of ASCII code's
  48.         of the desired word-part characters (Note: wou can also
  49.         say: "", what is equivalent to [] ; i.e. no extra
  50.         characters).
  51.     - lowercase conversion:
  52.         instantiate argument 5 with lowercase
  53.  
  54.  
  55. Main predicates provided:
  56.  
  57.     readln(P)        - Read a sentence up till NewLine and
  58.               unify <P> with the list of atoms/numbers
  59.               (identical to:
  60.                  readln(P, [10],"_01213456789",uppercase).)
  61.     readln(P, LastCh)   - idem as above but the second argument is unified
  62.               with the last character read (the ascii-code for
  63.               the stop-character or 'end_of_file')
  64.     readln(P, LastCh, Arg1, Arg2, Arg3)
  65.             - idem as above but the default setting is changed
  66.               for the instantiated args:
  67.               Arg1: List of stop characters
  68.               Arg2: List of word_part characters
  69.               Arg3: uppercase/lowercase conversion
  70.  
  71. Examples:
  72.     read_sentence( P,Case ) :-
  73.         readln( P,_,".!?","_0123456789",Case ).
  74.  
  75.     read_in( P ) :-                % with numbers as separate
  76.         readln( P,Eof,_,"", _ ).    % entities.
  77.  
  78.     read_atom( A ) :-            % stop on newline,
  79.         readln( A,_,_," ",_).        % space is part of word
  80.  
  81.  
  82.    Author: Wouter Jansweijer
  83.    Date: 26 april 1985
  84.  
  85. ******************************************************************************/
  86.  
  87. :- module( readln,[readln/1,readln/2,readln/5] ).
  88.  
  89. :- style_check( +dollar ).
  90.  
  91. readln( Read ) :-            % the default is read up to EOL
  92.     $readln( Line,LastCh,[10],"_0123456789",uppercase ),
  93.     (   LastCh \== end_of_file,
  94.         Read = Line
  95.     |   append( Line,[end_of_file],Read )
  96.     ), !.
  97.  
  98. readln(Read, LastCh):-
  99.     $readln(Read, LastCh, [10], "_0123456789", uppercase).
  100.  
  101. readln( P,EOF,StopChars,WordChars,Case ) :-
  102.     (   var( StopChars ),
  103.         Arg1 = [10]
  104.     |   Arg1 = StopChars
  105.     ),
  106.     (   var( WordChars ),
  107.         Arg2 = "01234567890_"
  108.     |   Arg2 = WordChars
  109.     ),
  110.     (   var( Case ),
  111.         Arg3 = lowercase
  112.     |   Arg3 = Case
  113.     ),  !,
  114.     $readln( P,EOF,Arg1,Arg2,Arg3 ).
  115.  
  116. $readln( P,EOF,StopChars,WordChars,Case ) :-
  117.     $initread( L,EOF,StopChars ),
  118.     $blanks( L,LL ), !,
  119.     $words( P,LL,[],options(WordChars,Case) ), !.
  120.  
  121. $initread( S,EOF,StopChars ) :- 
  122.     get0(K),
  123.     $readrest( K,S,EOF,StopChars ).
  124.  
  125. $readrest( -1,[],end_of_file,_ ) :- !.
  126. $readrest( 0'\,[K1|R],EOF,StopChars ) :-
  127.     get0( K1 ),                    % skip it, take next char
  128.     get0( K2 ),
  129.     $readrest( K2,R,EOF,StopChars ).
  130. $readrest( K,[K],K,StopChars ) :-            % the stop char(s)
  131.     member( K,StopChars ), !.
  132. $readrest( K,[K|R],EOF,StopChars ) :-            % the normal case
  133.     get0( K1 ),
  134.     $readrest( K1,R,EOF,StopChars ).
  135.  
  136. $words( [W|Ws],S1,S4,Options ) :-
  137.     $word( W,S1,S2,Options ), !,
  138.     $blanks( S2,S3 ),
  139.     $words( Ws,S3,S4,Options ).
  140. $words( [],S1,S2,_ ) :-
  141.     $blanks( S1,S2), !.
  142. $words( [],S,S,_ ).
  143.  
  144. $word( N,[46|S1],S3,_ ) :-        % the dot can be in the beginning of
  145.     $basic_num( N1,S1,S2 ),    !,    % a real number.
  146.     $basic_nums( Rest,S2,S3,dot ),    % N.B. only ONE dot IN a number !!
  147.     name( N,[48,46,N1|Rest] ).    % i.e '0.<number>'
  148. $word( N,S0,S2,_ ) :-
  149.     $basic_num( N1,S0,S1 ), !,
  150.     $basic_nums( Rest,S1,S2,_ ),
  151.     name( N,[N1|Rest] ).
  152. $word( W,S0,S2,Options ) :-
  153.     $basic_char( C1,S0,S1,Options ), !,
  154.     $basic_chars( Rest,S1,S2,Options ),
  155.     name( W,[C1|Rest] ).
  156. $word( P,[C|R],R,_ ) :-
  157.     name( P,[C] ), !.
  158.  
  159. $basic_chars( [A|As],S0,S2,Options ) :-
  160.    $basic_char( A,S0,S1,Options ), !,
  161.    $basic_chars( As,S1,S2,Options ).
  162. $basic_chars( [],S,S,_ ).
  163.  
  164. $basic_nums( [46,N|As],[46|S1],S3,Dot ) :- % a dot followed by at least one digit
  165.    var( Dot ),                   % but not found a dot already
  166.    $basic_num( N,S1,S2 ), !,
  167.    $basic_nums( As,S2,S3,dot ).
  168. $basic_nums( [A|As],S0,S2,Dot ) :-
  169.    $basic_num( A,S0,S1 ), !,
  170.    $basic_nums( As,S1,S2,Dot ).
  171. $basic_nums( [],S,S,_ ).
  172.  
  173. $blanks( [C|S0],S1 ) :-
  174.    $blank( C ), !,
  175.    $blanks( S0,S1 ).
  176. $blanks( S,S ).
  177.  
  178. /* Basic Character types that form $words together */
  179.  
  180. $basic_char( A,[C|S],S,options(WordChars,Case) ) :-
  181.     $lc( C,A,WordChars,Case ).
  182.  
  183. $basic_num( N,[N|R],R ) :-
  184.     between( 0'0,0'9,N ).
  185.  
  186. $blank(X) :-
  187.     X =< 32.
  188.  
  189. $lc( X,X1,_,Case ) :-    
  190.     between( 0'A,0'Z,X ), !,
  191.     $fix_case( Case,X,X1 ).
  192. $lc( X,X,_,_ ) :-
  193.     between( 0'a,0'z,X ), !.
  194. $lc( X,X,WordChars,_ ) :-
  195.     memberchk( X,WordChars ).
  196.  
  197. $fix_case( lowercase,U,L ) :- !,
  198.     plus( U,32,L ).
  199. $fix_case( _,C,C ).
  200.